Problema 3 - Checkpoint 3

require(GGally, quietly = TRUE)
require(reshape2, quietly = TRUE)
require(tidyverse, quietly = TRUE, warn.conflicts = FALSE)

## Loading tidyverse: ggplot2
## Loading tidyverse: tibble
## Loading tidyverse: tidyr
## Loading tidyverse: readr
## Loading tidyverse: purrr
## Loading tidyverse: dplyr

## Conflicts with tidy packages ----------------------------------------------

## filter(): dplyr, stats
## lag():    dplyr, stats

library(ggfortify)
library(cluster)
library(ggdendro)
library(broom)
library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(readr)
library(magrittr)

## 
## Attaching package: 'magrittr'

## The following object is masked from 'package:purrr':
## 
##     set_names

## The following object is masked from 'package:tidyr':
## 
##     extract

theme_set(theme_bw())

Tipos de filme quanto ao gênero do personagem e da quantidade de palavras que eles falam

Neste post vamos investigar a existência de tipos de filmes quanto ao gênero do personagem e da quantidade de palavras que ele fala. Esta investigação vai ajudar as pessoas a se confrontarem com o que se conhece popularmente a respeito de filmes voltados para o público feminino e os filmes do gênero de terror, por exemplo. Será que os filmes femininos o número de personagens é predominantemente feito de mulheres? Será que elas falam em maior quantidade que os homens? Será que existem grupos que definem comportamentos comuns para os filmes analisados? Utilizaremos os dados cedidos pelo Github. Github.

personagens = read_csv(file = "../dados/film-dialogue/character_list5.csv")

## Parsed with column specification:
## cols(
##   script_id = col_integer(),
##   imdb_character_name = col_character(),
##   words = col_integer(),
##   gender = col_character(),
##   age = col_character()
## )

personagens = personagens %>%
  filter(age != 'NULL') %>% 
  mutate(age = as.numeric(age))

filmes = read.csv(file = "../dados/film-dialogue/meta_data7.csv")
filmes = filmes %>%
  filter(gross != 'NA', gross > 0)

filmes_personagens = merge(filmes, personagens, by="script_id")

mulheres = filmes_personagens %>%
  filter(gender == 'f') %>%
  group_by(script_id, imdb_id, title, year, gross) %>%
  summarise(n_f=n(), words_f=median(words)) %>%
  filter(n_f > 1)

homens = filmes_personagens %>%
  filter(gender == 'm') %>%
  group_by(script_id, imdb_id, title, year, gross) %>%
  summarise(n_m=n(), words_m=median(words)) %>%
  filter(n_m > 1)

dados = merge(mulheres, homens, 
                           by=c('script_id','imdb_id','title','year','gross'))
duplicados = dados %>%
  group_by(title) %>% filter(row_number() > 1)

dados = dados %>% 
  filter(!(title %in% duplicados$title))
  
dados = dados %>%
  subset(select = -c(script_id,imdb_id,year,gross))

Decisões sobre filtrar dados ou variáveis

Observando os dados cedidos pelo repositório pude notar que o valor da variável idade, da tabela de personagens, não estava disponível ou continha valor nulo. Desta forma foi feita a filtragem dessas observações. A variável renda da tabela dos filmes tinha comportamento semelhente. Algumas observações continha valor não disponível ou então igual a zero, desta forma, eu achei que seria prudente filtra-los uma vez que, filmes sem valor de renda ou com valor de renda igual a zero não seriam relavantes na análise.

Uma limitação encontrada durante a análise foi o fato de alguns filmes possuirem o mesmo nome embora fossem diferentes então para submeter os dados para a análise eu tive que fazer a filtragem desses filmes com nomes repetidos também.

Esta análise só levará em consideração os filmes que contenham mais de um personagem de cada gênero.

As dimensões submetidas a análise

As dimensões submetidas a análise foram 4 variáveis numéricas calculadas a partir do conjunto de dados cedido pelo Github mencionado acima. São elas: nº de personagens do sexo feminino no filme, mediana de palavras dos personagens do sexo feminino no filme, nº de personagens do sexo masculino no filme e mediana de palavras dos personagens do sexo masculino no filme.

O conjunto de dados submetido a análise contém, para cada filme, uma observação com valores para cada variável mencionada acima. A escolha das variáveis acima visava obter a resposta para a seguinte pergunta: visando o gênero do personagem e a quantidade de palavras ditas por ele em um filme, quais os tipos de filmes? Filmes em que as mulheres são protagonistas? Filmes em que os homens são protagonistas?

dw = dados
# Escala de log 
dw2 <- dw %>% 
    mutate_each(funs(log), 2:5)
dw2.scaled = dw2 %>% 
  mutate_each(funs(as.vector(scale(.))), 2:5)

dists = dw2.scaled %>%
      column_to_rownames("title") %>% 
    dist(method = "euclidean")

hc = hclust(dists, method = "ward.D")

n_clusters = 4

dw2 <- dw2 %>% 
    mutate(cluster = hc %>% 
               cutree(k = n_clusters) %>% 
               as.character())

dw2.scaled <- dw2.scaled %>% 
    mutate(cluster = hc %>% 
               cutree(k = n_clusters) %>% 
               as.character())

dw2.long = melt(dw2.scaled, id.vars = c("title", "cluster"))

dw2.scaled = dw2.scaled %>% 
    select(-cluster) # Remove o cluster adicionado antes l? em cima via hclust

set.seed(123)
explorando_k = tibble(k = 1:15) %>% 
    group_by(k) %>% 
    do(
        kmeans(select(dw2.scaled, -title), 
               centers = .$k, 
               nstart = 20) %>% glance()
    )

## Warning: did not converge in 10 iterations

Escolhendo o valor de k

Antes de realizar o agrupamento precisamos escolher um bom valor para k (basicamente indica o número de grupos ou tipos que iremos identificar no conjunto de dados). Uma medida comumente usada no k-means é comparar a distância (quadrática) entre o centro dos clusters e o centro dos dados com a distância (quadrática) entre todos os pontos nos dados e o centro dos dados.

Aqui o centro dos dados é um ponto imaginário na média de todas as variáveis. Calculamos a distância do centro de cada cluster para o centro dos dados e multiplicamos pelo número de pontos nesse cluster. Somando esse valor para todos os clusters, temos betweenss abaixo. Se esse valor for próximo do somatório total das distâncias dos pontos para o centro dos dados (totss), os pontos estão próximos do centro de seu cluster. Essa proporção pode ser usada para definir um bom valor de k. Quando ela para de crescer, para de valer à pena aumentar k.

explorando_k %>% 
    ggplot(aes(x = k, y = betweenss / totss)) + 
    geom_line() + 
    geom_point()

Observando o gráfico acima fica fácil perceber que o melhor valor de k seria 4, já que, apartir de 4 betweenss começa a parar de crescer. O ponto k=4 é também conhecido como joelho da curva.

Agrupando os dados

# O agrupamento de fato:
km = dw2.scaled %>% 
    select(-title) %>% 
    kmeans(centers = n_clusters, nstart = 20)

# O df em formato longo, para visualiza??o 
dw2.scaled.km.long = km %>% 
    augment(dw2.scaled) %>% # Adiciona o resultado de km 
                            # aos dados originais dw2.scaled em 
                            # uma vari?vel chamada .cluster
    gather(key = "variável", 
           value = "valor", 
           -title, -.cluster) # = move para long todas as 
                                            # vari?vies menos title 
                                            # e .cluster
dw2.scaled.km.long %>% 
    ggplot(aes(x = `variável`, y = valor, group = title, colour = .cluster)) + 
    geom_line(alpha = .5) + 
    facet_wrap(~ .cluster) +
    xlab("Variável") + 
    ylab("Valor") +
    ggtitle("Gráfico de coordenadas paralelas") +
  theme(plot.title = element_text(hjust = 0.5))

Observando o gráfico acima e olhando a direção em que as linhas dos filmes cruzam e tocam cada uma das variáveis ou coordenadas podemos observar grupos que caracterizam os filmes que ali cabem.

Redução de dimensionalidade usando PCA (Análise de Componentes Principais)

Logo abaixo podemos ver a visualização 2D da redução de dimensionalidade das 4 dimensões mencionadas anteriormente.

ggplotly(autoplot(km, data = dw2.scaled, label = TRUE))

Descrição e interpretação da redução

Outra forma de ver a informação que o gráfico mostra é vendo PC1 e PC2 como duas funções das 4 variáveis originais, vejamos abaixo.

pr.out <- prcomp(select(dw, -title), scale=TRUE)
tidy(pr.out, "variables") %>% 
    filter(PC <= 2) %>% 
    spread(column, value)

##   PC       n_f        n_m    words_f    words_m
## 1  1 0.3389066  0.5046972 -0.5167654 -0.6028072
## 2  2 0.7290339 -0.5112447 -0.3543522  0.2856098

Os valores na tabela são os coeficientes, e a leitura é que:

PC1 = 0.34n_f + 0.50n_m - 0.52words_f − 0.60words_m e PC2 = 0.73n_f - 0.51n_m - 0.35words_f + 0.28words_m

Em PC1, mudar uma unidade nas 2 primeiras variáveis aumenta PC1 e faz com que um ponto esteja mais à direita no gráfico. Já words_f e words_m têm efeito negativo e de maior efeito por unidade do que as duas primeiras. A unidade aqui é em z-scores: todas as variáveis foram normalizadas com scale antes da redução de dimensionalidade, para que seu efeito ficasse comparável.

Em PC2, mudar uma unidade na primeira e última variável aumenta PC2 e faz com que um ponto esteja mais à cima no gráfico. Já n_m e words_f têm um efeito negativo e de menor efeito por unidade.

Interpretação da visualização

ggplotly(autoplot(km, data = dw2.scaled, label = TRUE))

Podemos entender que existem 4 grupos de filmes segundo as 4 variáveis que usamos. No grupo mais à esquerda no gráfico, estão espécies que tem valores no geral parecidos – e baixos – de Petal.Width, Petal.Length e Sepal.Length, mas que variam muito nos valores de Sepal.Width que tem. Existe um ponto mais em cima e à esquerda que é estranho nesse grupo também.